home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / marks.tcl < prev    next >
Encoding:
Text File  |  1997-12-10  |  5.6 KB  |  249 lines  |  [TEXT/ALFA]
  1.  
  2. # ================================================================================
  3. # Marks for front window.
  4. #================================================================================
  5.  
  6. proc pushMark {} {pushPosition}
  7. proc popMark {} {popPosition}
  8.  
  9. proc namedMarkProc {menu item} {
  10.     switch -- $item {
  11.         "markFile"            {markFile; message "File marked."}
  12.         "set"                 {setNamedMark}
  13.         "goto"                {gotoFileMark}
  14.         "remove"            {removeNamedMark}
  15.         "sort"                {sortMarksFile}
  16.         "sortByPosition"    {orderMarks}
  17.     }
  18. }
  19.  
  20. proc unnamedMarkproc {menu item} {
  21.     switch -- $item {
  22.         "set"                     {setMark}
  23.         "exchangePointAndMark"    {exchangePointAndMark}
  24.         "hilite"                {markHilite}
  25.     }
  26. }
  27.     
  28.  
  29.  
  30. proc gotoFileMark {} {
  31.     set text [getSelect]
  32.     if {[string length $text] && ([string length $text] < 20)} {
  33.         gotoMark [listpick -p "Mark?" -L [list $text] [getNamedMarks -n]]
  34.     } else {
  35.         gotoMark [listpick -p "Mark?" [getNamedMarks -n]]
  36.     }
  37. }
  38.  
  39. proc markFile {} {
  40.     if [llength [getNamedMarks -n]] {
  41.         global quietlyClearMarks
  42.         if {$quietlyClearMarks || [dialog::yesno -c "Clear old marks?"]} {
  43.             clearFileMarks
  44.         }
  45.     }
  46.     global mode
  47.     mode::proc MarkFile
  48. }
  49.  
  50. proc removeAllMarks {{pat *}} {
  51.     set win [win::Current]
  52.     if {![catch {
  53.         foreach mk [getNamedMarks -n] {
  54.             if [string match $pat $mk] {
  55.                 removeNamedMark -n $mk -w $win
  56.             }
  57.     } } ] } { return }
  58.     # some marks contain curly braces!
  59.     foreach mk [quote::Regfind [getNamedMarks -n]] {
  60.         if [string match $pat $mk] {
  61.             removeNamedMark -n $mk -w $win
  62.         }
  63.         if {[string index $mk 0] == "\{"} {
  64.             set mk [string range $mk 1 [expr [string length $mk] -1]]
  65.         }
  66.         if [string match $pat $mk] {
  67.             removeNamedMark -n $mk -w $win
  68.         }
  69.     }
  70. }
  71.  
  72. proc clearFileMarks {} {removeAllMarks}
  73.  
  74. proc sortMarksFile {} {
  75.     if {![dialog::yesno "Really sort all marks?"]} {return}
  76.  
  77.     set nm [win::Current]
  78.     
  79.     set mks {}
  80.     foreach mk [getNamedMarks] {
  81.         removeNamedMark -n [lindex $mk 0] -w [lindex $mk 1]
  82.         lappend mks $mk
  83.     }
  84.  
  85.     foreach mk [lsort $mks] {
  86.         set name [lindex $mk 0]
  87.         set disp [lindex $mk 2]
  88.         set pos [lindex $mk 3]
  89.         set end [lindex $mk 4]
  90.         
  91.         setNamedMark $name $disp $pos $end
  92.     }
  93. }
  94.  
  95. # From Mark Nagata
  96. proc zeroadd {num} {
  97.     set mx [maxPos]
  98.     set len [string length $mx]
  99.     set num [format "%0${len}d" $num]
  100.     return $num
  101. }
  102.  
  103. proc orderMarks {} {
  104.     if {![dialog::yesno "Really reorder all marks?"]} {return}
  105.  
  106.     set nm [win::Current]
  107.     
  108.     set wks {}
  109.     foreach mk [getNamedMarks] {
  110.         removeNamedMark -n [lindex $mk 0] -w $nm
  111.         set name [lindex $mk 0]
  112.         set disp [lindex $mk 2]
  113.         set pos [lindex $mk 3]
  114.         set end [lindex $mk 4]
  115.         set pos [zeroadd $pos]
  116.         set wk [list $pos $disp $name $end]
  117.         lappend wks $wk
  118.     }
  119.  
  120.     foreach wk [lsort $wks] {
  121.         set name [lindex $wk 2]
  122.         set disp [lindex $wk 1]
  123.         set pos [lindex $wk 0]
  124.         set end [lindex $wk 3]
  125.         
  126.         setNamedMark $name $disp $pos $end
  127.     }
  128. }
  129.  
  130.  
  131. # ================================================================================
  132. # Simple mark stack implementation
  133. # ================================================================================
  134.  
  135. proc pushPosition {{msg 1}} {
  136.     global markStack
  137.     global markName
  138.     
  139.     set name mark$markName
  140.     incr markName
  141.     createTMark $name [getPos]
  142.     set fileName [win::Current]
  143.     set markStack [linsert $markStack 0 [list $fileName $name]]
  144.     if {$msg} {
  145.         message [concat Mark [llength $markStack] Pushed]
  146.     }
  147. }
  148.  
  149. proc popPosition {{msg 1}} {
  150.     global markStack
  151.     if {[llength $markStack] == "0"} {
  152.         message "The mark stack is empty!"
  153.         return
  154.     }
  155.     set mark [lindex [lindex $markStack 0] 1]
  156.     set markStack [lreplace $markStack 0 0]
  157.     if {[catch {gotoTMark $mark}]} {
  158.         popPosition
  159.         return
  160.     }
  161.     if {$msg} {
  162.         message [concat Mark [expr [llength $markStack] + 1] Popped]
  163.     }
  164. }
  165.  
  166. # Used to create a popup of all funcs in window. Routine 
  167. # should return list containing, consecutively, proc name and
  168. # start of definition. 
  169. proc parseFuncsAlpha {} {
  170.     global mode sortFuncsMenu
  171.     if {[info procs ${mode}::parseFuncs] != ""} {
  172.         return [${mode}::parseFuncs]
  173.     } elseif {[info procs "parseFuncs$mode"] != ""} {
  174.         return [parseFuncs$mode]
  175.     } else {
  176.         global funcExpr parseExpr
  177.         
  178.         set pos 0
  179.         if $sortFuncsMenu {
  180.             while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  181.                 if {[regexp $parseExpr [getText [car $res] [cadr $res]] dummy word]} {
  182.                     lappend m [list $word [car $res]]
  183.                 }
  184.                 set pos [cadr $res]
  185.             }
  186.             regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  187.         } else {
  188.             while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  189.                 if {[regexp $parseExpr [getText [car $res] [cadr $res]] dummy word]} {
  190.                     lappend m $word [car $res]
  191.                 }
  192.                 set pos [cadr $res]
  193.             }
  194.         }
  195.         return $m
  196.     }
  197. }
  198.  
  199.  
  200. proc gotoFunc {} {
  201.     set l [parseFuncsAlpha]
  202.     if {[set ind [lsearch $l {(-}]] >= 0} {
  203.         set l [lrange $l [expr $ind + 2] end]
  204.     }
  205.     
  206.     while {[llength $l] > 1} {
  207.         lappend names [car $l]
  208.         lappend positions [cadr $l]
  209.         set l [cddr $l]
  210.     }
  211.     
  212.     set res [listpick -p "Func:" $names]
  213.     if {[set ind [lsearch $names $res]] >= 0} {
  214.         goto [lindex $positions $ind]
  215.     }
  216. }
  217.  
  218.  
  219. proc editMark {fname mname args} {
  220.     if {[set pos [lsearch [winNames -f] "*$fname*"]] >= 0}  {
  221.         bringToFront [lindex [winNames -f] $pos]
  222.         if {[icon -q]} {
  223.             icon -o
  224.         } 
  225.     } else {
  226.         if {[lsearch $args {-r}] >= 0} {
  227.             edit -r "$fname"
  228.         } else {
  229.             edit "$fname"
  230.         }
  231.     }
  232.     set mNames [getNamedMarks -n]
  233.     if {[set closestFound [lsearch -glob $mNames "*${mname}*"]] < 0} {
  234.         catch {mode::proc MarkFile}
  235.         set mNames [getNamedMarks -n]
  236.     } 
  237.     if {[lsearch $mNames "${mname}"] >= 0} {
  238.         gotoMark $mname
  239.     } elseif {[lsearch $mNames " ${mname}"] >= 0} {
  240.         #this gets used when procName is indented in pop-up -tr
  241.         gotoMark " $mname"
  242.     } else {
  243.         gotoMark [lindex $mNames $closestFound]
  244.     } 
  245.     
  246.     
  247. }
  248.  
  249.